home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
dataval.exe
/
VALID2.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1991-02-22
|
4KB
|
173 lines
{************************************************}
{ }
{ Turbo Pascal 6.0 }
{ Demo program from the Turbo Vision Guide }
{ }
{ Copyright (c) 1990 by Borland International }
{ }
{************************************************}
{$X+}
program TVGUID16;
uses Objects, Drivers, Views, Menus, Dialogs, App;
type
DialogData = record
InputLineData: string[128];
end;
TMyApp = object(TApplication)
constructor Init;
procedure InitStatusLine; virtual;
procedure NewDialog;
end;
PDemoDialog = ^TDemoDialog;
TDemoDialog = object(TDialog)
function Valid(Command: Word): Boolean; virtual;
end;
PValidInputLine = ^TValidInputLine;
TValidInputLine = object(TInputLine)
IsValid: Boolean;
constructor Init(var Bounds: TRect; AMaxLen: Integer);
function GetPalette: PPalette; virtual;
procedure HandleEvent(var Event: TEvent); virtual;
function Valid(Command: word): Boolean; virtual;
end;
function TDemoDialog.Valid(Command: Word): Boolean;
var Q: PView;
function IsInvalid(P: PView): Boolean; far;
begin
IsInvalid := not P^.Valid(Command);
end;
begin
Q := FirstThat(@IsInvalid);
if Q <> nil then
if Q <> Current then
Q^.Select { The input line will not be redrawn in }
else { the passive error color if it is already }
begin { selected. By moving the Current pointer }
Lock; { forward, and then back again, we can get }
SelectNext(True); { the passive error color. The Lock and }
SelectNext(False); { Unlock are to prevent flicker. }
Unlock;
end;
Valid := (Q = nil);
end;
constructor TValidInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
begin
TInputLine.Init(Bounds, AMaxLen);
IsValid := Valid(cmOk);
end;
function TValidInputLine.GetPalette: PPalette;
const AltPalette: String[Length(CInputLine)] = CInputLine;
begin
{ By assigning a palette index number that is out of the range of
our owner's palette, we automatically get flashing white on red
for this color entry. This should instead be mapped to an
actual palette entry in the owner... }
AltPalette[1] := #255;
if IsValid then
GetPalette := TInputLine.GetPalette
else
GetPalette := @AltPalette;
end;
procedure TValidInputLine.HandleEvent(var Event: TEvent);
begin
if Event.What <> evnothing then
IsValid := True;
TInputLine.HandleEvent(Event);
end;
function TValidInputLine.Valid(Command: Word): Boolean;
begin
if Command <> cmCancel then
begin
IsValid := (Data^ = 'Hello');
Valid := IsValid;
write(#7); { "hear" where & when Valid is called }
end;
end;
var
DemoDialogData: DialogData;
{ TMyApp }
constructor TMyApp.Init;
begin
TApplication.Init;
NewDialog;
end;
procedure TMyApp.InitStatusLine;
var R: TRect;
begin
GetExtent(R);
R.A.Y := R.B.Y - 1;
StatusLine := New(PStatusLine, Init(R,
NewStatusDef(0, $FFFF,
NewStatusKey('', kbF10, cmMenu,
NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
nil))),
nil)
));
end;
procedure TMyApp.NewDialog;
var
Bruce: PView;
Dialog: PDemoDialog;
R: TRect;
C: Word;
begin
R.Assign(20, 6, 60, 19);
Dialog := New(PDemoDialog, Init(R, 'Demo Dialog'));
with Dialog^ do
begin
R.Assign(3, 8, 37, 9);
Bruce := New(PValidInputLine, Init(R, 128));
Insert(Bruce);
R.Assign(2, 7, 37, 8);
Insert(New(PLabel, Init(R, 'Type: Hello, then Tab around.', Bruce)));
R.Assign(15, 10, 25, 12);
Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
R.Assign(28, 10, 38, 12);
Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
end;
Dialog^.SetData(DemoDialogData);
C := DeskTop^.ExecView(Dialog);
if C <> cmCancel then Dialog^.GetData(DemoDialogData);
Dispose(Dialog, Done);
end;
var
MyApp: TMyApp;
begin
with DemoDialogData do
begin
InputLineData := 'Phone home.';
end;
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.